home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 03 / 1 / DISK0317.ZIP / INDXCARD.BAS < prev    next >
BASIC Source File  |  1983-11-21  |  21KB  |  246 lines
  1. 1 ' (PC)^3 Software Submission MAKSTKFL authored on January 4, 1983 by
  2. 2 '
  3. 3 ' Michael Csontos, 3228 Livonia Center Road, Lima, New York 14485
  4. 4 '
  5. 5 ' Copyright 1983 Michael Csontos
  6. 6 '
  7. 7 '  This program is made freely available non-exclusively to the Picture
  8. 8 '  City Personal Computer Programmers' Club for distribution to its members
  9. 9 '  and through software exchange to other users groups as long as credit is
  10. 10 ' given to the author and (PC)^3.
  11. 11 '
  12. 12 '
  13. 13 ' NOTE: The files MAKSTKFL.DOC, UPDSTKFL.DAT, and data files with the
  14. 14 ' extensions FRM, KEY, DTA, HDR, RPT, BAT and INX are associated with this
  15. 15 ' program.
  16. 16 '
  17. 10000 CLS:PRINT "INDXCARD - (C) 1983  Michael Csontos":PRINT
  18. 10100 PRINT "This program uses the IBM Color/Graphics Adapter,":PRINT
  19. 10200 PRINT "a 80 column display (not colored), and a disk drive.":PRINT
  20. 10300 PRINT "Printer commands issued by the program are for an EPSON MX-80.":PRINT
  21. 10400 PRINT "The size of the records created by this program requires":PRINT
  22. 10500 PRINT "that you enter BASICA with the disk buffer set to 1024 bytes.":PRINT
  23. 10600 PRINT "Use the command:   BASICA INDXCARD /S:1024   to start if you get an":PRINT
  24. 10700 PRINT "error message."
  25. 10800 PRINT:PRINT:PRINT "Press any key to start."
  26. 10900 X$=INKEY$:IF X$="" THEN 10900
  27. 11000 DEF SEG=&HB800:DEFINT A-Z:DIM CK$(58),FLDUSED(18),FLD$(19,2),F$(18):SCREEN 0,0,0:COLOR 7,0,0:WIDTH 80:WIDTH"LPT1:",255:KEY OFF:M=0:CLS
  28. 11100 ON ERROR GOTO 11200:OPEN "indxcard.key" FOR INPUT AS #3:FOR N=1 TO 58:LINE INPUT #3,CK$(N):NEXT N:CLOSE #3:GOTO 11400
  29. 11200 CLOSE #3:RESUME 11300
  30. 11300 ON ERROR GOTO 0
  31. 11400 ON ERROR GOTO 12700:OPEN "indxcard.dta" FOR INPUT AS #2:CLOSE #2:ON ERROR GOTO 0
  32. 11500 PRINT "There is already a file called INDXCARD.DTA on the disk in the default drive.   You have four choices:":PRINT
  33. 11600 PRINT "   1.) quit and copy or rename the file,":PRINT
  34. 11700 PRINT "   2.) print the data on index cards,":PRINT
  35. 11800 PRINT "   3.) add new data to that file,":PRINT
  36. 11900 PRINT "   4.) continue and erase the present file.
  37. 12000 PRINT:PRINT "Please press 1,2,3,or 4"
  38. 12100 X$=INKEY$:IF X$="" THEN 12100 ELSE AAA=ASC(X$)-48:IF AAA<1 OR AAA>4 THEN 12100 ELSE IF AAA=1 THEN 16400
  39. 12200 CLS:OPEN "indxcard.dta" AS #2 LEN=865
  40. 12300 FIELD #2,48 AS F$(1),48 AS F$(2),48 AS F$(3),48 AS F$(4),48 AS F$(5),48 AS F$(6),48 AS F$(7),48 AS F$(8),48 AS F$(9),48 AS F$(10),48 AS F$(11),48 AS F$(12),48 AS F$(13),48 AS F$(14),48 AS F$(15),48 AS F$(16),48 AS F$(17),48 AS F$(18),1 AS EF$
  41. 12400 LSET EF$=CHR$(10):IF AAA=2 THEN 15800 ELSE IF AAA<>3 THEN 12900
  42. 12500 Z!=LOF(2):CARD=Z!/865:IF CARD=0 THEN CARD=1
  43. 12600 GET #2,CARD:IF LEFT$(F$(1),1)="\" THEN 12900 ELSE CARD=CARD+1:GOTO 12900
  44. 12700 RESUME 12800
  45. 12800 ON ERROR GOTO 0:CARD=1:GOTO 12200
  46. 12900 ON ERROR GOTO 13200:OPEN "indxcard.frm" FOR INPUT AS #1:ON ERROR GOTO 0
  47. 13000 FOR N=1 TO 18:LINE INPUT #1,FLD$(N,0):NEXT N:CLOSE #1
  48. 13100 PRINT " The following card format is on the disk in your default drive. You may use it or edit it now using <Alt>+<F7>. Any changes will replace the file on the disk.":GOTO 14200
  49. 13200 CLOSE #1:RESUME 13300
  50. 13300 ON ERROR GOTO 0
  51. 13400 FOR N=1 TO 9:FLD$(N,0)=STRING$(10,CHR$(193))+"Field "+STR$(N)+STRING$(30,CHR$(193)):NEXT
  52. 13500 FOR N=10 TO 18:FLD$(N,0)=STRING$(10,CHR$(193))+"Field"+STR$(N)+STRING$(30,CHR$(193)):NEXT
  53. 13600 PRINT " Fill in the fields with anything that will help you fill in the card later.    Leave fields as shown to leave them blank on the cards."
  54. 13700 LOCATE 23,33:PRINT "FIELD DEFINITION";:LOCATE 3,1:GOSUB 16500'CRDBLANK
  55. 13800 LOCATE 25,1:PRINT SPC(20)"PRESS <Alt>+<F8> WHEN FINISHED, <Alt>+<F1> TO QUIT";
  56. 13900 LOCATE 4,22,1:GOSUB 17100'CRDWRITE
  57. 14000 GOSUB 21400'scancard
  58. 14100 LOCATE 1,1:PRINT " The following is the format for your card.  If you want to change it before    continuing press <Alt><F7>.  This will allow you to resume editing the format."
  59. 14200 LOCATE 3,1:GOSUB 16500'crdblank
  60. 14300 LOCATE 23,1:PRINT " If you continue, this format will be saved on disk in the file INDXCARD.FRM    for possible future reference.                                                ";
  61. 14400 GOSUB 16600:IF REPEAT=1 THEN CLS:GOTO 13600'nextpage
  62. 14500 GOSUB 22100'save card format
  63. 14600 LOCATE 1,1:PRINT " You may now start filling out the cards. To do this, simply type over any      lines on the screen, using the screen editing keys.                           ";
  64. 14700 LOCATE 23,1:PRINT STRING$(159," ");
  65. 14800 LOCATE 25,1:PRINT "PRESS <Alt>+<F8> FOR NEXT CARD, <Alt>+<F1> TO QUIT, <Alt>+<F9> TO END THE FILE.";
  66. 14900 FINISH2=0:R=4:C=22:M=1
  67. 15000 IF FLD$(R-3,0)=STRING$(48," ") THEN R=R+1:GOTO 15000 ELSE RRR=R
  68. 15100 LOCATE 23,22:PRINT "CARD: "CARD"      FILE SIZE: "LOF(2)" BYTES";:LOCATE RRR,22:GOSUB 17100'cardwrite
  69. 15200 IF FINISH2=1 THEN IF NTEND THEN CARD=LSTCRD:GOTO 15400 ELSE 15400 ELSE GOSUB 21400:GOSUB 22600'scancard,savecard
  70. 15300 IF NTEND=1 THEN CARD=LSTCRD:NTEND=0:GOTO 15100:ELSE CARD=CARD+1:GOTO 15100'next card
  71. 15400 LSET F$(1)="\":RSET F$(18)="\":RSET EF$="\":ON ERROR GOTO 24200:PUT #2,CARD:ON ERROR GOTO 0
  72. 15500 CLS:PRINT "You now have a file called INDXCARD.DTA which may be sorted, edited, or printed with the program PC-FILE and a file INDXCARD.KEY containing any <Alt>+<char.>   definitions you may have entered.":PRINT
  73. 15600 OPEN "indxcard.key" FOR OUTPUT AS #3:FOR N=1 TO 58:PRINT #3,CK$(N):NEXT N:CLOSE #3
  74. 15700 PRINT "You may now print the cards in the file in the same order that they were enteredor stop and sort the file for printing later.":PRINT
  75. 15800 PRINT "If you are now ready to start printing cards, set up the printer so that the    first card is positioned so that the print head is at its upper left hand       corner.":PRINT
  76. 15900 PRINT " You may print continuously if you have form feed cards, but if you want the    printer to stop after each card in an attempt to single-feed cards, then press  <Alt><F7> to continue from this page.":PRINT
  77. 16000 PRINT " The printing will start immediately when you leave this page."
  78. 16100 GOSUB 16600:IF REPEAT=1 THEN SINGLE=1'nextpage
  79. 16200 GOSUB 22700'prntcard
  80. 16300 GOSUB 25500'prtsetup
  81. 16400 CLS:KEY ON:END
  82. 16500 LOCATE 3,16:PRINT CHR$(218)STRING$(48,CHR$(196))CHR$(191):FOR N=1 TO 18:LOCATE N+3,16:PRINT CHR$(179)FLD$(N,M)CHR$(179):NEXT N:LOCATE N+3,16:PRINT CHR$(192)STRING$(48,CHR$(196))CHR$(217);:RETURN'-----------CARDBLANK-----------------
  83. 16600 REPEAT=0:LOCATE 25,1:PRINT "PRESS ANY KEY TO CONTINUE EXCEPT <Esc> TO QUIT OR PRESS <Alt><F7>.           ";'------------------NEXTPAGE------------------
  84. 16700 X$=INKEY$:IF LEN(X$)>1 THEN 17000 ELSE IF X$="" THEN GOTO 16700 ELSE IF X$=CHR$(27) THEN GOTO 16800 ELSE FOR N=0 TO 15:DUMP$=INKEY$:NEXT:RETURN
  85. 16800 LOCATE 25,1:PRINT "Are you sure you want to quit?"STRING$(49," ");:GOSUB 23600:ON A GOTO 16600,16900,16800'YESORNO
  86. 16900 KEY ON:COLOR 7,0,0:CLS:END
  87. 17000 IF ASC(RIGHT$(X$,1))=110 THEN REPEAT=1:RETURN ELSE 16700
  88. 17100 FINISH1=0:FOR N=1 TO 18:FLDUSED(N)=0:NEXT N:LOCATE ,,1'------cardwrite---
  89. 17200 X$=INKEY$:IF X$="" THEN 17200 ELSE I=0:B=0
  90. 17300 R=CSRLIN:C=POS(0):IF E=1 THEN LOCATE 24,1,0:PRINT STRING$(79," ");:E=0:LOCATE R,C,1
  91. 17400 IF LEN(X$)>1 THEN GOSUB 18500:IF FINISH1=1 OR FINISH2=1 THEN RETURN ELSE 17200'EXTNDCOD
  92. 17500 X=ASC(X$)'------------------------single byte keys---------------------
  93. 17600 IF X=13 AND R<21 AND M=0 THEN LOCATE R+1,22:GOTO 17200'carriage ret
  94. 17700 IF X=13 AND R<22 AND M>0 THEN R=R+1:IF FLD$(R-3,0)=STRING$(48," ") AND R<22 THEN 17700 ELSE IF R=22 THEN 17200 ELSE LOCATE R,22:GOTO 17200'
  95. 17800 IF X=8 AND C>17 THEN C=C-1:LOCATE ,C:GOSUB 30500:GOTO 17200'backspace
  96. 17900 IF X=9 THEN 29000'tab right
  97. 18000 IF X=27 THEN LOCATE R,17:PRINT FLD$(R-3,0);:FLDUSED(R-3)=0:LOCATE R,22:GOTO 17200'esc
  98. 18100 IF X<32 THEN 21100'non-character
  99. 18200 IF X<127 AND C<65 AND FLDUSED(R-3)=0 THEN LOCATE R,17:PRINT STRING$(48," ");:LOCATE R,C:FLDUSED(R-3)=1'clear field if first character
  100. 18300 IF X<127 AND C<65 THEN PRINT X$;:IF C=64 THEN LOCATE R,C:GOTO 17200 ELSE 17200'enter character
  101. 18400 GOTO 21100'not valid character
  102. 18500 X=ASC(RIGHT$(X$,1))'----------------two byte keys----------------------
  103. 18600 IF X=15 THEN 29200'shift tab
  104. 18700 IF X=71 THEN IF M=0 THEN LOCATE 4,22:RETURN ELSE IF FLD$(B+1,0)=STRING$(48," ") AND B<18 THEN B=B+1:GOTO 18700 ELSE LOCATE B+4,22:B=0:RETURN'home
  105. 18800 IF X=72 AND R>4 AND M=0 THEN PRINT CHR$(30);:RETURN'cursor up
  106. 18900 IF X=72 AND R>3 AND M>0 THEN R=R-1:IF FLD$(R-3,0)=STRING$(48," ") AND R>3 THEN 18900 ELSE IF R=3 THEN RETURN ELSE LOCATE R,C:RETURN'cursor up
  107. 19000 IF X=75 AND C>17 THEN PRINT CHR$(29);:RETURN'cursor left
  108. 19100 IF X=77 AND C<64 THEN PRINT CHR$(28);:RETURN'cursor right
  109. 19200 IF X=79 THEN 31400'end
  110. 19300 IF X=80 AND R<21 AND M=0 THEN PRINT CHR$(31);:RETURN'cursor down
  111. 19400 IF X=80 AND R<22 AND M>0 THEN R=R+1:IF FLD$(R-3,0)=STRING$(48," ") AND R<22 THEN 19400 ELSE IF R=22 THEN RETURN ELSE LOCATE R,C:RETURN'cursor down
  112. 19500 IF X=82 THEN 29400'insert
  113. 19600 IF X=83 THEN 30500'delete
  114. 19700 IF X=104 THEN LOCATE 25,1:PRINT "Are you sure you want to quit?" STRING$(49," ");:GOSUB 23600:ON A GOTO 21200,21300,21200'alt f1 - quit
  115. 19800 IF X=105 THEN LPRINT CHR$(27)CHR$(64);:GOSUB 25900:GOTO 25500'alt f2 - list f keys
  116. 19900 IF X=106 THEN 28300'alt f3 - list alt keys
  117. 20000 IF X=107 THEN 26600'alt f4 - program a alt-character key
  118. 20100 IF (X=108 OR X=132) AND CARD>1 THEN MV=-1:GOSUB 28700:LOCATE R,C:RETURN'alt f5 or <Ctrl>+<PgUp> - previous card
  119. 20200 IF (X=109 OR X=118) AND NTEND AND CARD<LSTCRD THEN MV=1:GOSUB 28700:LOCATE R,C:RETURN'alt f6 or <Ctrl>+<PgDn> - next card
  120. 20300 IF X=111 THEN FINISH1=1:RETURN'alt f8 - finished with card
  121. 20400 IF X=112 THEN FINISH2=1:RETURN'alt f9 - through entering cards
  122. 20500 IF X=113 THEN FLDUSED(R-3)=1:RETURN'alt f10 - edit displayed line
  123. 20600 IF X=115 THEN 29800'ctrl cursor left
  124. 20700 IF X=116 THEN 30700'ctrl cursor right
  125. 20800 IF X=117 THEN 31600'ctrl end
  126. 20900 IF X=119 THEN 31800'ctrl home
  127. 21000 Y=X:CHAR=0:GOSUB 27400:IF CHAR=0 THEN 21100 ELSE IF I=1 THEN 40000 ELSE IF FLDUSED(R-3)=0 THEN LOCATE R,17:PRINT STRING$(48," ");:LOCATE R,C:PRINT LEFT$(CK$(CHAR),65-C);:FLDUSED(R-3)=1:RETURN ELSE PRINT LEFT$(CK$(CHAR),65-C);:RETURN'print phrase
  128. 21100 LOCATE 24,1:E=1:PRINT "Not a valid character or command at this position. ASCII code:";:IF LEN(X$)>1 THEN PRINT ASC(LEFT$(X$,1)) ASC(RIGHT$(X$,1));:LOCATE R,C:RETURN ELSE PRINT ASC(X$);:LOCATE R,C:GOTO 17200
  129. 21200 LOCATE 25,1:PRINT SPC(20)"PRESS <Alt>+<F8> WHEN FINISHED, <Alt>+<F1> TO QUIT";:LOCATE R,C:RETURN
  130. 21300 CLS:CLOSE:KEY ON:END
  131. 21400 FOR N=1 TO 18'------------------------scancard------------------------
  132. 21500 LOCATE N+3,15,0:PRINT CHR$(26);:LOCATE N+2,15:PRINT " ";
  133. 21600 IF M>0 AND FLD$(N,0)=STRING$(48," ") THEN FLD$(N,M)=STRING$(48," "):GOTO 21900
  134. 21700 IF M=0 AND PEEK(352+160*N)=193 THEN FLD$(N,M)=STRING$(48," "):GOTO 21900
  135. 21800 FLD$(N,M)=" ":FOR P=1 TO 48:FLD$(N,M)=FLD$(N,M)+CHR$(PEEK(350+160*N+2*P)):NEXT P:FLD$(N,M)=RIGHT$(FLD$(N,M),48)
  136. 21900 NEXT N
  137. 22000 LOCATE 21,15:PRINT " ":RETURN
  138. 22100 ON ERROR GOTO 24200'---------------save card format--------------------
  139. 22200 OPEN "indxcard.frm" FOR OUTPUT AS #1
  140. 22300 FOR N=1 TO 18:PRINT #1,FLD$(N,0):NEXT N
  141. 22400 CLOSE #1:ON ERROR GOTO 0
  142. 22500 FOR N=1 TO 18:LOCATE N+3,1:PRINT MID$(FLD$(N,0),6,14);:LOCATE N+3,66:PRINT MID$(FLD$(N,0),20,14):NEXT N:RETURN
  143. 22600 FOR N=1 TO 18:LSET F$(N)=FLD$(N,M):NEXT N:ON ERROR GOTO 24200:PUT #2,CARD:ON ERROR GOTO 0:RETURN'----save card---
  144. 22700 ON ERROR GOTO 23700'--------------------PRNTCARD-----------------------
  145. 22800 LPRINT CHR$(27)CHR$(64)CHR$(27)CHR$(69);'printer commands
  146. 22900 GET #2,1:FOR N=1 TO 18:LPRINT F$(N):NEXT N:IF SINGLE=1 THEN 23200
  147. 23000 GET #2:IF LEFT$(F$(1),1)="\" THEN 23400
  148. 23100 FOR N=1 TO 18:LPRINT F$(N):NEXT N
  149. 23200 IF SINGLE=1 THEN LOCATE 24,1:PRINT "Press <Alt><F7> to go to continuous printing.";:GOSUB 16600:IF REPEAT=1 THEN SINGLE=0:LOCATE 24,1:PRINT STRING$(79," ");
  150. 23300 GOTO 23000
  151. 23400 ON ERROR GOTO 0:RETURN
  152. 23500 '---------------------yes or no answer--------------------------------
  153. 23600 X$=INKEY$:IF X$="" THEN GOTO 23600 ELSE IF X$="N" OR X$="n" THEN A=1:RETURN:ELSE IF X$="Y" OR X$="y" THEN A=2:RETURN:ELSE A=3:LOCATE 25,40:PRINT "Please answer Y,y,N,or n";:FOR N=0 TO 5000:NEXT :FOR N=0 TO 15:DUMP$=INKEY$:NEXT:RETURN
  154. 23700 IF ERR = 27 THEN PRINT "Printer off or out of paper. Program will continue when problem is corrected.":RESUME'------------prterror-----------------------
  155. 23800 IF ERR = 68 THEN PRINT "Printer unavailable or disabled. Program will continue when problem is corrected.":RESUME
  156. 23900 IF ERR = 25 THEN PRINT "Printer fault. Program will continue when problem is corrected.":RESUME
  157. 24000 IF ERR = 24 THEN PRINTIME=PRINTIME+1 ELSE PRINT "PRTERROR problem.":ON ERROR GOTO 0:STOP
  158. 24100 IF PRINTIME < 2 THEN RESUME ELSE PRINT "Printer off line. Program will continue when problem is corrected.":PRINTIME=0:RESUME
  159. 24200 R=CSRLIN:C=POS(0):LOCATE 23,1'---------------diskerror-------------------
  160. 24300 IF ERR=24 THEN PRINT "No disk in drive? Device timeout.":GOTO 25400
  161. 24400 IF ERR=53 THEN PRINT "There is no file for this program on this disk.";:NOFILE=1:LOCATE R,C:RESUME
  162. 24500 IF ERR=57 THEN PRINT "I/O error. Try another disk.":GOTO 25400
  163. 24600 IF ERR=61 THEN LOCATE 24,1:PRINT "Disk full. Last card not entered. Previous card made end-of-file.              ":FOR N=1 TO 4000:NEXT N:GET #2,LOC(2)-2:RESUME 15400
  164. 24700 IF ERR=64 THEN PRINT "Bad file name. Software problem.":STOP
  165. 24800 IF ERR=67 THEN PRINT "Too many files in directory. Try another disk to temoroarily save your data.":GOTO 25400
  166. 24900 IF ERR=68 THEN PRINT "Disk drive unavailable.":GOTO 25400
  167. 25000 IF ERR=70 THEN PRINT "You have write protected this disk!":GOTO 25400
  168. 25100 IF ERR=71 THEN PRINT "No disk in drive or door not closed.":GOTO 25400
  169. 25200 IF ERR=72 THEN PRINT "Disk Media Error. Try another disk.":GOTO 25400
  170. 25300 PRINT "DISKERROR problem.";:ON ERROR GOTO 0:STOP
  171. 25400 PRINT "Program will continue when problem is corrected.";:LOCATE R,C:RESUME
  172. 25500 LPRINT CHR$(27) "@";'-------------------printsetup---------------------
  173. 25600 LPRINT CHR$(27);"C";CHR$(0);CHR$(11);      'ESC,FORM LENGTH,11 INCHES
  174. 25700 LPRINT CHR$(15);CHR$(27);CHR$(65);CHR$(9);'COMPRESSED,ESC,LINE FEED,9/72"
  175. 25800 RETURN
  176. 25900 LPRINT CHR$(27)CHR$(69);
  177. 26000 LPRINT:LPRINT "<Alt>+<F1> = Quit (during screen editing and most other functions).":LPRINT:LPRINT "<Alt>+<F2> = Print this list of function key settings.
  178. 26100 LPRINT:LPRINT "<Alt>+<F3> = Print a list of the <Alt>+<character> key settings.":LPRINT:LPRINT "<Alt>+<F4> = Program an <Alt>+<character> key."
  179. 26200 LPRINT:LPRINT "<Alt>+<F5> = Page back to previous card.":LPRINT:LPRINT "<Alt>+<F6> = Page foreward to next card (if not at end of file)."
  180. 26300 LPRINT:LPRINT "<Alt>+<F7> = Unassigned.":LPRINT:LPRINT "<Alt>+<F8> = Finished with card."
  181. 26400 LPRINT:LPRINT "<Alt>+<F9> = Finished entering cards.":LPRINT:LPRINT "<Alt>+<F10> = Edit the previous entry as shown (instead of clearing it).
  182. 26500 RETURN
  183. 26600 LOCATE 25,1:PRINT "Enter <Alt>+<the key you want to use>:                                         ";'----program alt-character key----------------
  184. 26700 GOSUB 27300:IF CHAR=0 THEN 27100 ELSE KYSTR=CHAR'identify key
  185. 26800 CK$(KYSTR)="":LOCATE 25,1:PRINT "Enter a string: ";:COLOR 0,7:PRINT STRING$(48," ");:LOCATE 25,17
  186. 26900 Y$=INKEY$:IF Y$="" OR LEN(Y$)>1 THEN 26900 ELSE IF ASC(Y$)=13 THEN 27200 ELSE IF ASC(Y$)=8 AND POS(0)>17 THEN 27000 ELSE CHAR=0:GOSUB 27400:IF CHAR=0 THEN 26900 ELSE CK$(KYSTR)=CK$(KYSTR)+Y$:PRINT Y$;:IF LEN(CK$(KYSTR))>48 THEN 27200 ELSE 26900
  187. 27000 KYS=LEN(CK$(KYSTR))-1:CK$(KYSTR)=LEFT$(CK$(KYSTR),KYS):LOCATE 25,17:PRINT CK$(KYSTR) " ";:LOCATE ,POS(0)-1:GOTO 26900
  188. 27100 LOCATE 25,1:PRINT "This key cannot be programmed                                                  ";:FOR N=1 TO 4000:NEXT N
  189. 27200 COLOR 7,0:LOCATE 25,1:PRINT "PRESS <Alt>+<F8> FOR NEXT CARD, <Alt>+<F1> TO QUIT, <Alt>+<F9> TO END THE FILE.";:LOCATE R,C:RETURN
  190. 27300 Y$=INKEY$:IF Y$="" OR LEN(Y$)<2 THEN 27300 ELSE IF ASC(Y$)=13 THEN RETURN ELSE Y=ASC(RIGHT$(Y$,1)):CHAR=0
  191. 27400 IF Y>15 AND Y<26 THEN CHAR=Y-15
  192. 27500 IF Y>29 AND Y<39 THEN CHAR=Y-19
  193. 27600 IF Y>43 AND Y<51 THEN CHAR=Y-24
  194. 27700 IF Y>83 AND Y<104 THEN CHAR=Y-57
  195. 27800 IF Y>119 AND Y<132 THEN CHAR=Y-73
  196. 27900 RETURN
  197. 28000 DATA "A",11,"4",50,"B",24,"5",51,"C",22,"6",52,"D",13,"7",53,"E",3,"8",54,"F",14,"9",55,"G",15,"0",56,"H",16,"-",57,"I",8,"=",58,"J",17,"<SHIFT>+<F1>",27
  198. 28100 DATA "K",18,"<SHIFT>+<F2>",28,"L",19,"<SHIFT>+<F3>",29,"M",26,"<SHIFT>+<F4>",30,"N",25,"<SHIFT>+<F5>",31,"O",9,"<SHIFT>+<F6>",32,"P",10,"<SHIFT>+<F7>",33,"Q",1,"<SHIFT>+<F8>",34,"R",4,"<SHIFT>+<F9>",35,"S",12,"<SHIFT>+<F10>",36
  199. 28200 DATA "T",5,"<Ctrl>+<F1>",37,"U",7,"<Ctrl>+<F2>",38,"V",23,"<Ctrl>+<F3>",39,"W",2,"<Ctrl>+<F4>",40,"X",21,"<Ctrl>+<F5>",41,"Y",6,"<Ctrl>+<F6>",42,"Z",20,"<Ctrl>+<F7>",43,"1",47,"<Ctrl>+<F8>",44,"2",48,"<Ctrl>+<F9>",45,"3",49,"<Ctrl>+<F10>",46
  200. 28300 GOSUB 25500'printer to compressed print----------print alt keys---------
  201. 28400 LPRINT CHR$(14) " INDXCARD    --    ALTERNATE KEY ASSIGNMENTS     " DATE$:LPRINT
  202. 28500 PFLD1$=SPACE$(48):PFLD2$=SPACE$(48)
  203. 28600 FOR N=1 TO 29:READ C1$,C1,C2$,C2:LSET PFLD1$=CK$(C1):LSET PFLD2$=CK$(C2):LPRINT C1$" = "PFLD1$ SPC(10) C2$" = "PFLD2$:LPRINT:NEXT N:GOSUB 25900:LPRINT CHR$(12);:RESTORE:GOTO 25500
  204. 28700 IF NTEND=0 THEN LSTCRD=CARD:NTEND=1
  205. 28800 CARD=CARD+MV:X$=INKEY$:IF LEN(X$)>1 THEN X=ASC(RIGHT$(X$,1)):IF X=108 OR X=109 THEN LOCATE 23,22:PRINT "CARD: "CARD"   ";:IF CARD=1 THEN 28900 ELSE RETURN 20100
  206. 28900 GET #2, CARD:FOR N=1 TO 18:FLD$(N,M)=F$(N):NEXT N:LOCATE 23,22:PRINT "CARD: "CARD"      FILE SIZE: "LOF(2)" BYTES  ";:GOTO 16500
  207. 29000 IF C<22 THEN C=22 ELSE IF C<28 THEN C=28 ELSE IF C<34 THEN C=34 ELSE IF C<40 THEN C=40 ELSE IF C<46 THEN C=46 ELSE IF C<52 THEN C=52 ELSE IF C<58 THEN C=58
  208. 29100 LOCATE R,C:GOTO 17200
  209. 29200 IF C>58 THEN C=58 ELSE IF C>52 THEN C=52 ELSE IF C>46 THEN C=46 ELSE IF C>40 THEN C=40 ELSE IF C>34 THEN C=34 ELSE IF C>28 THEN C=28 ELSE IF C>22 THEN C=22
  210. 29300 LOCATE R,C:RETURN
  211. 29400 IF C>63 THEN LOCATE ,,,7,7:RETURN'----------insert--------------
  212. 29500 FLDUSED(R-3)=1:LOCATE ,,,4,7:U=160*(R-1)+2*(C-1):UMAX=160*(R-1)+126
  213. 29600 X$=INKEY$:IF X$="" THEN 29600 ELSE IF LEN(X$)>1 THEN IF ASC(RIGHT$(X$,1))=82 THEN LOCATE ,,,7,7:RETURN ELSE LOCATE ,,,7,7:I=1:GOTO 18500 ELSE X=ASC(X$):IF X=8 THEN C=C-1:LOCATE ,C:GOSUB 30500:GOTO 29400 ELSE IF X<32 THEN LOCATE ,,,7,7:RETURN 17400
  214. 29700 FOR N=UMAX TO U STEP -2:POKE N,PEEK(N-2):NEXT N:POKE U,X:C=C+1:LOCATE R,C:GOTO 29400
  215. 29800 RR=R:CC=C:FLDUSED(R-3)=1'----------ctrl cursor right------------------
  216. 29900 U=160*(RR-1)+2*(CC-1):UMIN=160*(RR-1)+32
  217. 30000 FOR N=U-2 TO UMIN STEP -2:IF PEEK(N)<>32 THEN 30200 ELSE CC=CC-1:NEXT N
  218. 30100 RR=RR-1:CC=64:IF RR<4 THEN RETURN ELSE 29900
  219. 30200 U=N:FOR N=U TO UMIN STEP -2:IF PEEK(N)=32 THEN 30400 ELSE CC=CC-1:NEXT N
  220. 30300 RETURN
  221. 30400 LOCATE RR,CC:RETURN
  222. 30500 FLDUSED(R-3)=1:U=160*(R-1)+2*(C-1):UMAX=160*(R-1)+126'---delete--------
  223. 30600 FOR N=U TO UMAX-2 STEP 2:POKE N,PEEK(N+2):NEXT N:POKE UMAX,32:RETURN
  224. 30700 RR=R:CC=C:FLDUSED(R-3)=1'----------ctrl cursor right------------------
  225. 30800 U=160*(RR-1)+2*(CC-1):UMAX=160*(RR-1)+126
  226. 30900 FOR N=U TO UMAX STEP 2:IF PEEK(N)=32 THEN 31100 ELSE CC=CC+1:NEXT N
  227. 31000 RR=RR+1:CC=17:IF RR>21 THEN RETURN ELSE 30800
  228. 31100 U=N:FOR N=U TO UMAX STEP 2:IF PEEK(N)<>32 THEN 31300 ELSE CC=CC+1:NEXT N
  229. 31200 GOTO 31000
  230. 31300 LOCATE RR,CC:RETURN
  231. 31400 FLDUSED(R-3)=1:U=160*(R-1)+32:UMAX=160*(R-1)+126'------end--------
  232. 31500 C=64:FOR N=UMAX TO U STEP-2:IF PEEK(N)=32 THEN C=C-1:NEXT N ELSE IF C=64 THEN LOCATE ,C:RETURN ELSE LOCATE ,C+1:RETURN
  233. 31600 FLDUSED(R-3)=1:U=160*(R-1)+2*(C-1):UMAX=160*(R-1)+126'---ctrl end--------
  234. 31700 FOR N=U TO UMAX STEP 2:POKE N,32:NEXT N:RETURN
  235. 31800 U=512:UMAX=606'---------------------------------ctrl home----------
  236. 31900 FOR N=U TO UMAX STEP 2:POKE N,32:NEXT N
  237. 32000 U=U+160:UMAX=UMAX+160:IF UMAX<3328 THEN 31900 ELSE R=4
  238. 32100 IF FLD$(R-3,0)=STRING$(48," ") THEN R=R+1:IF R>21 THEN LOCATE 4,17:RETURN ELSE 32100
  239. 32200 LOCATE R,22:RETURN
  240. 40000 FOR O=LEN(CK$(CHAR)) TO 1 STEP -1'-----------insert phrase-------------
  241. 40100 FOR N=UMAX TO U STEP -2:POKE N,PEEK(N-2):NEXT N:POKE U,ASC(MID$(CK$(CHAR),O,1)):C=C+1:IF C>63 THEN LOCATE R,C:I=0:RETURN
  242. 40200 NEXT O:LOCATE R,C:I=0:GOTO 29400
  243. 65000 '         SAVE"b:indxcard.bas"
  244. 65100 ' KEY 7,"kill"+chr$(34)+"indxcard":KEY 8,".dta"+chr$(34)
  245. CATE R,C:I=0:GOTO 29400
  246. 65000 '         SAVE"b:in